#lang racket

;; this code implements a parser using racket specific functions
;;
;; in future it needs to be reimplemented in plain scheme

(require racket/match)
(provide parse-file
         sid sid? sid-id sid-metadata set-sid-id! set-sid-metadata!
         special special? special-id special-metadata set-special-id! set-special-metadata!
         syx->datum)

(define (parse-file filename)
  (call-with-input-file filename
    (lambda (in)
      (port-count-lines! in)
      (let loop ()
        (let ((object (read-syntax filename in)))
          (if (eof-object? object)
              '()
              (cons (process-syntax-object object) (loop))))))))

(struct sid ((id #:mutable) (metadata #:mutable)) #:transparent)
(struct special ((id #:mutable) (metadata #:mutable)) #:transparent)

(define (syntax-metadata stx)
  (list (cons 'source (syntax-source stx))
        (cons 'line (syntax-line stx))
        (cons 'column (syntax-column stx))))

(define (process-syntax-object stx)
  (let ((e (if (syntax? stx) (syntax-e stx) stx)))
    (cond ((or (number? e) (boolean? e) (string? e)) e)
          ((symbol? e) (sid e (syntax-metadata stx)))
          ((pair? e) (cons (process-syntax-object (car e))
                           (process-syntax-object (cdr e))))
          ((null? e) '())
          (else (error "unknown syntax object" stx)))))

;; > (parse-file "t1.scm")
;; (list
;;  (list
;;   (sid 'define '((source . "t1.scm") (line . 1) (column . 1)))
;;   (sid 'main '((source . "t1.scm") (line . 1) (column . 8)))
;;   (list (sid 'print '((source . "t1.scm") (line . 1) (column . 14))) "hello world!")))

(define (syx->datum e)
  (cond ((or (number? e) (boolean? e) (string? e)) e)
	((sid? e) (sid-id e))
	((special? e) (special-id e))
	((list? e) (map syx->datum e))
	(else (error "syx->datum" e))))
